home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 11 / FM Towns Free Software Collection 11.iso / t_os / tool / russian / russian.bas next >
BASIC Source File  |  1995-07-20  |  9KB  |  119 lines
  1. 10 'ロシア語入力支援ツール Девушка
  2. 20 '                         Programmed by S.J.Tanabe when 17 July 1995
  3. 30 'Programmed by S.J.Tanabe for FM-Towns F-BASIC 386 v2.1
  4. 40 '
  5. 100 '＊＊＊　初期設定　＊＊＊
  6. 110 CLS:SCREEN@ 0:COLOR 7,0:CONSOLE 1,20,0:PALETTE 2,[0,72,0]:PALETTE 1,[0,0,64]:PALETTE 7,[12,12,32]:CLEAR:LOCATE 9,0:COLOR 6:PRINT"★★★  ロシア語入力支援ツール  Девушка  ver. 1.0  ★★★"
  7. 120 LINE(0,0)-(639,15),PSET,%2,BF:LINE(0,16)-(639,396),PSET,%7,BF:LINE(0,397)-(635,475),PSET,%1,BF:LINE(4,401)-(639,479),PSET,1,B:LINE(2,399)-(637,477),PSET,5,B:LINE(0,397)-(635,475),PSET,7,B:ON ERROR GOTO 5000
  8. 130 LOCATE 0,22:COLOR 4:PRINT" .txtの拡張子が付いているテキストファイルのあるディスクを":PRINT SPACE$(27)+"ドライブA: (0)  に入れて、何かキーを押してください。"
  9. 140 LINE(0,0)-(639,16),PSET,2,B:FOR Y=35 TO 396 STEP 19:FOR X=0 TO 639 STEP 4:PSET(X,Y),1:NEXT:NEXT:I$=INPUT$(1):CLOSE#1,#2:GOTO 150
  10. 150 FOR Y=1 TO 23:LOCATE 0,Y:PRINT CHR$(27)+"T":NEXT:COLOR 7:LOCATE 0,1:FILES "A:\*.TXT":BEEP:COLOR 3:LOCATE 0,23:PRINT" ★  何も入力しないで、[Return]を押すと終了します。":COLOR 6:LOCATE 0,22:PRINT" ■　<入力>    ソースファイル名（ファイル名のみ）:";
  11. 160 COLOR 7:LINE INPUT IN$
  12. 170 IF IN$="" THEN BEEP:LINE(0,0)-(639,479),PSET,0,BF:CLS:CLOSE#1,#2:END
  13. 180 BEEP:COLOR 3:LOCATE 0,22:PRINT CHR$(27)+"T":LOCATE 0,23:PRINT " ★  何も入力しないとＡドライブの同じファイル（拡張子は.txr）となります。":COLOR 5:LOCATE 0,22:PRINT" ■　<出力>　    露文ファイル名（ドライブとファイル名）:";
  14. 190 COLOR 7:LINE INPUT OU$
  15. 200 N=0:FR=0:IF OU$="" THEN OU$="A:\"+IN$
  16. 210 OPEN "A:\"+IN$+".TXT" FOR INPUT AS #1
  17. 220 OPEN OU$+".TXR" FOR OUTPUT AS #2
  18. 500 '＊＊＊　コンパイル　＊＊＊
  19. 510 FOR Y=1 TO 24:LOCATE 0,Y:PRINT CHR$(27)+"T":NEXT:LOCATE 0,22:COLOR 5:PRINT " ★  コンパイルを始めます。"
  20. 520 FR=0
  21. 530 FOR Y=21 TO 24:LOCATE 0,Y:PRINT CHR$(27)+"T":NEXT:LOCATE 0,22:COLOR 5:PRINT " ★  コンパイルをしています。中断は[Break ]キーを押してください。":LOCATE 0,1:COLOR 7
  22. 540 L=0:N=N+1:INPUT#1,A$
  23. 550 L=L+1:IF A$="" THEN PRINT:PRINT#2,:GOTO 540 
  24. 560 IF KMID$(A$,L,1)="[" THEN FR=1:L=L+1
  25. 570 IF FR=0 THEN PRINT KMID$(A$,L,1);:PRINT#2,KMID$(A$,L,1);:GOTO 600 ELSE IF FR=1 THEN 580
  26. 580 IF KMID$(A$,L,1)="." THEN AA=ASC(KMID$(A$,L+1,1)):IF (AA >= 65 AND AA <= 90) THEN GOSUB 1010 ELSE IF (AA >= 97 AND AA <= 122) THEN GOSUB 2000 ELSE GOSUB 3000
  27. 590 IF KMID$(A$,L,1)="]" THEN FR=0
  28. 600 IF L > KLEN(A$) THEN PRINT:PRINT#2, ELSE 550 
  29. 610 IF EOF(1) THEN BEEP:LOCATE 0,22:PRINT CHR$(27)+"T":COLOR 5:LOCATE 0,22:PRINT " ★  コンパイルが終了しました。何かキーを押してください。":I$=INPUT$(1):CLOSE#1,#2:GOTO 100 ELSE GOTO 540
  30. 1000 '＊＊＊　変換　サブルーチン　＊＊＊
  31. 1010 '　大文字
  32. 1020 IF KMID$(A$,L+1,1)="A" THEN PRINT"А";:PRINT#2,"А"; :RETURN
  33. 1030 IF KMID$(A$,L+1,1)="B" THEN PRINT"Б";:PRINT#2,"Б"; :RETURN
  34. 1040 IF KMID$(A$,L+1,1)="V" THEN PRINT"В";:PRINT#2,"В"; :RETURN
  35. 1050 IF KMID$(A$,L+1,1)="G" THEN PRINT"Г";:PRINT#2,"Г"; :RETURN
  36. 1060 IF KMID$(A$,L+1,1)="D" THEN PRINT"Д";:PRINT#2,"Д"; :RETURN
  37. 1070 IF KMID$(A$,L+1,2)="YE" THEN PRINT"Е";:PRINT#2,"Е"; :L=L+1:RETURN
  38. 1080 IF KMID$(A$,L+1,2)="YO" THEN PRINT"Ё";:PRINT#2,"Ё"; :L=L+1:RETURN
  39. 1090 IF KMID$(A$,L+1,1)="J" THEN PRINT"Ж";:PRINT#2,"Ж"; :RETURN
  40. 1100 IF KMID$(A$,L+1,1)="Z" THEN PRINT"З";:PRINT#2,"З"; :RETURN
  41. 1110 IF KMID$(A$,L+1,1)="I" AND NOT KMID$(A$,L+1,2)="IK" THEN PRINT"И";:PRINT#2,"И"; :RETURN
  42. 1120 IF KMID$(A$,L+1,2)="IK" THEN PRINT"Й";:PRINT#2,"Й"; :L=L+1:RETURN
  43. 1130 IF KMID$(A$,L+1,1)="K" THEN PRINT"К";:PRINT#2,"К"; :RETURN
  44. 1140 IF KMID$(A$,L+1,1)="L" THEN PRINT"Л";:PRINT#2,"Л"; :RETURN
  45. 1150 IF KMID$(A$,L+1,1)="M" AND NOT KMID$(A$,L+1,2)="MZ" THEN PRINT"М";:PRINT#2,"М"; :RETURN
  46. 1160 IF KMID$(A$,L+1,1)="N" THEN PRINT"Н";:PRINT#2,"Н"; :RETURN
  47. 1170 IF KMID$(A$,L+1,1)="O" THEN PRINT"О";:PRINT#2,"О"; :RETURN
  48. 1180 IF KMID$(A$,L+1,1)="P" THEN PRINT"П";:PRINT#2,"П"; :RETURN
  49. 1190 IF KMID$(A$,L+1,1)="R" THEN PRINT"Р";:PRINT#2,"Р"; :RETURN
  50. 1200 IF KMID$(A$,L+1,1)="S" AND NOT KMID$(A$,L+1,2)="SH" AND NOT KMID$(A$,L+1,2)="SS" THEN PRINT"С";:PRINT#2,"С"; :RETURN
  51. 1210 IF KMID$(A$,L+1,1)="T" AND NOT KMID$(A$,L+1,2)="TT" AND NOT KMID$(A$,L+1,2)="TZ" THEN PRINT"Т";:PRINT#2,"Т"; :RETURN
  52. 1220 IF KMID$(A$,L+1,1)="U" THEN PRINT"У";:PRINT#2,"У"; :RETURN
  53. 1230 IF KMID$(A$,L+1,1)="F" THEN PRINT"Ф";:PRINT#2,"Ф"; :RETURN
  54. 1240 IF KMID$(A$,L+1,1)="H" THEN PRINT"Х";:PRINT#2,"Х"; :RETURN
  55. 1250 IF KMID$(A$,L+1,2)="TT" THEN PRINT"Ц";:PRINT#2,"Ц"; :L=L+1:RETURN
  56. 1260 IF KMID$(A$,L+1,2)="CH" THEN PRINT"Ч";:PRINT#2,"Ч"; :L=L+1:RETURN
  57. 1270 IF KMID$(A$,L+1,2)="SH" THEN PRINT"Ш";:PRINT#2,"Ш"; :L=L+1:RETURN
  58. 1280 IF KMID$(A$,L+1,2)="SS" THEN PRINT"Щ";:PRINT#2,"Щ"; :L=L+1:RETURN
  59. 1290 IF KMID$(A$,L+1,2)="TZ" THEN PRINT"Ъ";:PRINT#2,"Ъ"; :L=L+1:RETURN
  60. 1300 IF KMID$(A$,L+1,2)="WI" THEN PRINT"Ы";:PRINT#2,"Ы"; :L=L+1:RETURN
  61. 1310 IF KMID$(A$,L+1,2)="MZ" THEN PRINT"Ь";:PRINT#2,"Ь"; :L=L+1:RETURN 
  62. 1320 IF KMID$(A$,L+1,1)="E" THEN PRINT"Э";:PRINT#2,"Э"; :RETURN
  63. 1330 IF KMID$(A$,L+1,2)="YU" THEN PRINT"Ю";:PRINT#2,"Ю"; :L=L+1:RETURN
  64. 1340 IF KMID$(A$,L+1,2)="YA" THEN PRINT"Я";:PRINT#2,"Я"; :L=L+1:RETURN
  65. 1350 COLOR 2:BEEP:LOCATE 0,22:PRINT CHR$(27)+"T":LOCATE 0,22:PRINT USING" ★  ｢大文字｣でコンパイルエラーが発生しました！ 場所は ###行 ###文字目";N,L:CLOSE #1,#2:I$=INPUT$(1):END
  66. 2000 '　小文字
  67. 2010 IF KMID$(A$,L+1,1)="a" THEN PRINT"а";:PRINT#2,"а"; :RETURN
  68. 2020 IF KMID$(A$,L+1,1)="b" THEN PRINT"б";:PRINT#2,"б"; :RETURN
  69. 2030 IF KMID$(A$,L+1,1)="v" THEN PRINT"в";:PRINT#2,"в"; :RETURN
  70. 2040 IF KMID$(A$,L+1,1)="g" THEN PRINT"г";:PRINT#2,"г"; :RETURN
  71. 2050 IF KMID$(A$,L+1,1)="d" THEN PRINT"д";:PRINT#2,"д"; :RETURN
  72. 2060 IF KMID$(A$,L+1,2)="ye" THEN PRINT"е";:PRINT#2,"е"; :L=L+1:RETURN
  73. 2070 IF KMID$(A$,L+1,2)="yo" THEN PRINT"ё";:PRINT#2,"ё"; :L=L+1:RETURN
  74. 2080 IF KMID$(A$,L+1,1)="j" THEN PRINT"ж";:PRINT#2,"ж"; :RETURN
  75. 2090 IF KMID$(A$,L+1,1)="z" THEN PRINT"з";:PRINT#2,"з"; :RETURN
  76. 2100 IF KMID$(A$,L+1,1)="i" AND NOT KMID$(A$,L+1,2)="ik" THEN PRINT"и";:PRINT#2,"и"; :RETURN
  77. 2110 IF KMID$(A$,L+1,2)="ik" THEN PRINT"й";:PRINT#2,"й"; :L=L+1:RETURN
  78. 2120 IF KMID$(A$,L+1,1)="k" THEN PRINT"к";:PRINT#2,"к"; :RETURN
  79. 2130 IF KMID$(A$,L+1,1)="l" THEN PRINT"л";:PRINT#2,"л"; :RETURN
  80. 2140 IF KMID$(A$,L+1,1)="m" AND NOT KMID$(A$,L+1,2)="mz" THEN PRINT"м";:PRINT#2,"м"; :RETURN
  81. 2150 IF KMID$(A$,L+1,1)="n" THEN PRINT"н";:PRINT#2,"н"; :RETURN
  82. 2160 IF KMID$(A$,L+1,1)="o" THEN PRINT"о";:PRINT#2,"о"; :RETURN
  83. 2170 IF KMID$(A$,L+1,1)="p" THEN PRINT"п";:PRINT#2,"п"; :RETURN
  84. 2180 IF KMID$(A$,L+1,1)="r" THEN PRINT"р";:PRINT#2,"р"; :RETURN
  85. 2190 IF KMID$(A$,L+1,1)="s" AND NOT KMID$(A$,L+1,2)="sh" AND NOT KMID$(A$,L+1,2)="ss" THEN PRINT"с";:PRINT#2,"с"; :RETURN
  86. 2200 IF KMID$(A$,L+1,1)="t" AND NOT KMID$(A$,L+1,2)="tt" AND NOT KMID$(A$,L+1,2)="tz" THEN PRINT"т";:PRINT#2,"т"; :RETURN
  87. 2210 IF KMID$(A$,L+1,1)="u" THEN PRINT"у";:PRINT#2,"у"; :RETURN
  88. 2220 IF KMID$(A$,L+1,1)="f" THEN PRINT"ф";:PRINT#2,"ф"; :RETURN
  89. 2230 IF KMID$(A$,L+1,1)="h" THEN PRINT"х";:PRINT#2,"х"; :RETURN
  90. 2240 IF KMID$(A$,L+1,2)="tt" THEN PRINT"ц";:PRINT#2,"ц"; :L=L+1:RETURN
  91. 2250 IF KMID$(A$,L+1,2)="ch" THEN PRINT"ч";:PRINT#2,"ч"; :L=L+1:RETURN
  92. 2260 IF KMID$(A$,L+1,2)="sh" THEN PRINT"ш";:PRINT#2,"ш"; :L=L+1:RETURN
  93. 2270 IF KMID$(A$,L+1,2)="ss" THEN PRINT"щ";:PRINT#2,"щ"; :L=L+1:RETURN
  94. 2280 IF KMID$(A$,L+1,2)="tz" THEN PRINT"ъ";:PRINT#2,"ъ"; :L=L+1:RETURN
  95. 2290 IF KMID$(A$,L+1,2)="wi" THEN PRINT"ы";:PRINT#2,"ы"; :L=L+1:RETURN
  96. 2300 IF KMID$(A$,L+1,2)="mz" THEN PRINT"ь";:PRINT#2,"ь"; :L=L+1:RETURN 
  97. 2310 IF KMID$(A$,L+1,1)="e" THEN PRINT"э";:PRINT#2,"э"; :RETURN
  98. 2320 IF KMID$(A$,L+1,2)="yu" THEN PRINT"ю";:PRINT#2,"ю"; :L=L+1:RETURN
  99. 2330 IF KMID$(A$,L+1,2)="ya" THEN PRINT"я";:PRINT#2,"я"; :L=L+1:RETURN
  100. 2340 COLOR 2:BEEP:LOCATE 0,22:PRINT CHR$(27)+"T":LOCATE 0,22:PRINT USING" ★  ｢小文字｣でコンパイルエラーが発生しました！ 場所は ###行 ###文字目";N,L:CLOSE #1,#2:I$=INPUT$(1):END
  101. 3000 '　特殊記号
  102. 3010 IF KMID$(A$,L+1,1)=" " THEN PRINT "  ";:PRINT#2,"  "; :RETURN
  103. 3020 IF KMID$(A$,L+1,1)="\" THEN PRINT "，";:PRINT#2,"，"; :RETURN
  104. 3030 IF KMID$(A$,L+1,1)="@" THEN PRINT "．";:PRINT#2,"．"; :RETURN
  105. 3040 IF KMID$(A$,L+1,1)="/" THEN PRINT "  ／  ";:PRINT#2,"  ／  "; :RETURN
  106. 3050 IF KMID$(A$,L+1,1)="-" THEN PRINT "  －－  ";:PRINT#2,"  －－  "; :RETURN
  107. 3060 IF KMID$(A$,L+1,1)="<" THEN PRINT "≪  ";:PRINT#2,"≪  "; :RETURN 
  108. 3070 IF KMID$(A$,L+1,1)=">" THEN PRINT "  ≫";:PRINT#2,"  ≫"; :RETURN
  109. 3080 COLOR 2:BEEP:LOCATE 0,22:PRINT CHR$(27)+"T":LOCATE 0,22:PRINT USING" ★  ｢特殊記号｣でコンパイルエラーが発生しました！ 場所は ###行 ###文字目";N,L:CLOSE #1,#2:I$=INPUT$(1):END
  110. 5000 '＊＊＊　エラー処理　＊＊＊
  111. 5010 COLOR 2:IF ERR=52 THEN CLOSE#1,#2:RESUME
  112. 5020 IF ERR=63 THEN BEEP:LOCATE 0,23:PRINT " ★  該当するファイルはこのディスクにはありません。入れ換えてください。":I$=INPUT$(1):RESUME 110
  113. 5030 IF ERR=64 THEN KILL OU$+".TXR":RESUME 200
  114. 5040 IF ERR=66 THEN BEEP:LOCATE 0,23:PRINT " ★  ファイルが多すぎますので別のディスクを用意してください":I$=INPUT$(1):RESUME 110
  115. 5050 IF ERR=67 THEN BEEP:LOCATE 0,23:PRINT " ★  ディスク容量が足りないので別のディスクを用意してください":I$=INPUT$(1):RESUME 110
  116. 5060 IF ERR=72 THEN BEEP:LOCATE 0,23:PRINT " ★  テキストファイルのあるディスクをＡドライブに入れてください。":I$=INPUT$(1):RESUME 110
  117. 5070 IF ERR=125 THEN BEEP:RESUME
  118. 5080 ON ERROR GOTO 0
  119.